8bitfiles.net/archives/archives.tar/archives/compuserve-file-archive/19 Adventure Games/POPULA.BIN

Commodore BASIC | 2019-04-13 | 13.4 KB | 589 lines

10 REM TITLE SCREEN
20 POKE 53281,1:POKE 53280,2
30 PRINT "";:GOSUB 20000
40 PRINT "";
50 PRINT "P O P U L A T I O N";
60 PRINT "[157][157][157][157][157][157][157][157]" ;
70 PRINT "BY  D.N.I.";
80 DEF FNA(X)=INT(RND(1)*X+1)
100 DIM A$(500 ),B%( 4,500 )
110 DIM BI%(3,100),MA%(200)
120 DIM DE%(100),DI%(2,100)
130 DIM S%(5,9 ),Y%(200)
140 DIM A2$(200 ),B2%(4,200 )
150 DIM SM%(250),SF%(250)
160 DIM Q%(100),F%(100),N$(200)
170 DIM C1$( 9),C2$( 9,5)
200 DATA STATUS,SEX,YEAR OF BIRTH,SPOUSE
210 DATA HEIGHT,NOSE,SKIN COLOR,HAIR
220 DATA EYES
250 FOR T=1 TO  9:READ C1$(T):NEXT
260 DATA SINGLE,MARRIED,DEAD,X
270 DATA MALE,FEMALE,X
280 DATA X
290 DATA X
300 DATA SHORT,MEDIUM,TALL,X
310 DATA POINTED,FLAT,X
320 DATA BLACK,WHITE,BROWN,YELLOW,RED,X
330 DATA BLACK,BROWN,RED,BLOND,X
340 DATA BLUE,BROWN,GREY,GREEN,BLACK,X
420 FOR T=1 TO  9
430 E=1
440 READ S$:IF S$="X" THEN 470
450 C2$(T,E)=S$
455 REM PRINT C1$(T)  ,C2$(T,E)
460 E=E+1:GOTO 440
470 NEXT T
500 DATA TOM,DICK,HARRY,FRED,DAVE,BOB,CHRIS,JOHN,SCOTT
510 DATA ART,BRIAN,JASON,JOSH,JIM,RICK
515 DATA ADRIAN,ADAM,ALAN,ANDREW,ANTHONY
520 DATA ARNOLD,BARRY,BEN,BERT,BRUCE
524 DATA CALVIN,CARL,DAN,CRAIG,CURTIS
530 DATA DREW,DEREK,DON,EARL,ED,ERIC
535 DATA FELIX,FRANK,GARY,JEFF,GILBERT
540 DATA GEORGE,GLENN,GUS,GUY,HAL,HARRY
545 DATA HARVEY,IAN,IVAN,JACK,JAY,JOE
550 DATA JUSTIN,KENT,LEE,LARS,LEON
555 DATA LUKE,MARK,MATT,MAX,MIKE,MILT
560 DATA MOSES,NEVILLE,NIGEL,NOAH
565 DATA OLIVER,PAT,PAUL,PETER,RALPH
570 DATA RAY,REGGI,ROD,ROGER,RON,ROY
575 DATA SAM,SEAN,SID,STEVEN,TED,TIM
580 DATA TONY,WALTER,BILL,ZEKE
599 DATA X
600 DATA ROBIN,MARY,CAROLYN,ANN,RENEA
610 DATA SUE,BARB,JOAN,MARTHA,JUNE
620 DATA DIANE,LISA,JUDY,PAT,ROSE
625 DATA ABBY,AGNES,ALEXIS,ALISON
630 DATA AMELIA,AMY,ANGELA,ANITA,APRIL
635 DATA ATHENE,AVIS,BETH,BETTY,CAROL
640 DATA CHAR,CHERYL,CINDY,CORA,DAISY
645 DATA DAPHNE,DAWN,LILAH,DESIREE
650 DATA DIANE,DORA,DONNA,DORIS,DOT
655 DATA EDIE,LIZA,ELSA,EMMA,ESTHER
660 DATA EVE,FAITH,FANNY,FAY,GAIL,GRACE
665 DATA GWEN,HELEN,HOPE,INEZ,IRIS,IVY
670 DATA JANE,JO,JOY,KAREN,KATE,KAY
675 DATA LILY,LINDA,LOLA,LUCY,MARGIE
680 DATA MOLLY,MYRT,NANCY,NINA,PAM,PEARL
685 DATA PEG,POLLY,GINA,BECKY,RUTH,SALLY
690 DATA SUE,TRUDY,URSULA,GINNY,WENDY
699 DATA X
700 T=1
710 READ N$:IF N$="X"THEN 730
720 N$(T)=N$:T=T+1:GOTO710
730 NM=T-1:T=101
740 READ N$:IF N$="X" THEN 760
750 N$(T)=N$:T=T+1:GOTO 740
760 NF=T-101
800 FOR T=0 TO 100
810 Q%(T)=1000-.9*1.07^T
820 NEXT T
900 DATA 100,100,100,100,100,100,100,100,999
950 T=14
960 READ F:IF F=999 THEN 980
970 F%(T)=F:T=T+1:GOTO 960
980 FOR E=T TO 45:F%(E)=F%(E-1)-.5:NEXT
1000 GOSUB 20100
1010 PRINT "";:POKE 53280,5:GOSUB 20000
1020 PRINT "";"       M E N U  A"
1030 PRINT " 1. INSTRUCTIONS"
1035 PRINT
1040 PRINT " 2. CONSTRUCT A STARTING":PRINT"      POPULATION"
1050 PRINT
1060 PRINT " 3. LET COMPUTER CONSTRUCT":PRINT" POPULATION"
1070 PRINT "    ";:INPUT A
1080 IF A>3 OR A<1 THEN 1010
1110 ON A GOTO 1200,1300,1400
1200 REM INSTRUCTIONS
1201 PRINT "[147]"
1202 PRINT "EIGHT PEOPLE HAVE BEEN STRANDED ON A"
1203 PRINT "DESERTED ISLAND WITHOUT HOPE OF RESCUE"
1204 PRINT "TRACK THEIR DESCENDENTS WITH THIS"
1205 PRINT "PROGRAM. WATCH THE INHERITANCE OF "
1206 PRINT "      HEIGHT"
1207 PRINT "      HAIR COLOR"
1208 PRINT "      SKIN COLOR"
1209 PRINT "      EYE COLOR"
1210 PRINT " AND  NOSE SHAPE"
1211 PRINT "IN THE SUCEEDING GENERATIONS ON THE"
1212 PRINT "ISLAND. YOU CAN INFLUENCE THEM BY"
1213 PRINT "PLAYING MATCHMAKER"
1214 PRINT "HAVE FUN!"
1215 GOSUB 20100
1217 PRINT "[147]"
1220 PRINT "YOU CAN CONSTRUCT THE POPULATION "
1221 PRINT "YOURSELF OR LET THE COMPUTER DO IT FOR"
1222 PRINT "YOU. WATCH FOR THE EMERGENCE OF "
1223 PRINT "RECESSIVE CHARACTERISTICS IN EACH"
1224 PRINT "GENERATION.":PRINT""
1225 PRINT "THERE IS NO PRE-SET OBJECTIVE TO THIS"
1226 PRINT "SIMULATION. YOU CAN MAKE UP YOUR OWN,"
1227 PRINT "OR JUST SIT BACK AND WATCH"
1234 PRINT "HAVE FUN!"
1235 GOSUB 20100
1299 GOTO 1010
1300 REM YOU CONSTRUCT
1305 FOR Z=1 TO 8
1306 PRINT "[147]"
1307 PRINT "PERSON #";Z:PRINT
1310 PRINT "ENTER (1) FOR MALE, (2) FOR FEMALE";:INPUT S
1320 PRINT "ENTER FIRST,MIDDLE,LAST NAME"
1325 INPUT F$,M$,L$
1330 L$(Z)=L$
1335 A$(Z)=F$+" "+M$+" "+L$
1340 B%(1,Z)=1E4:B%(2,Z)=S*1E4
1342 M=1E4
1345 FOR T=1 TO 5
1346 PRINT C1$(T+4):PRINT "ENTER:"
1348 FOR K=1 TO 5
1350 IF C2$(T+4,K)=""  THEN 1354
1352 PRINT ,K;C2$(T+4,K)
1354 NEXT K
1356 INPUT C:IF C2$(T+4,C)="" THEN 1346
1358 B%(3,Z)=B%(3,Z)+M*C
1360 C=FNA(5):IFC2$(T+4,C)="" THEN 1360
1362 B%(4,Z)=B%(4,Z)+M*C
1364 M=M/10
1366 NEXT T
1368 NEXT Z
1370 GOTO 1625
1399 GOTO 1010
1400 REM START FROM SCRATCH
1405 Y0=20
1410 DATA SMITH,JONES,BROWN,WOLF
1420 DATA ROGERS,SULLIVAN,INGRAM,WEST
1425 PRINT "[147]";"";
1430 FOR Z=1 TO 8
1440 S=FNA(2)
1445 N5=NM:IF S=2 THEN N5=NF
1450 F=FNA(N5 )+100*(S-1)
1460 IF N$(F)="" THEN 1450
1470 M=FNA( N5)+100*(S-1)
1480 IF M=F THEN 1470
1490 IF N$(M)="" THEN 1470
1500 READ L$:L$(Z)=L$
1510 A$(Z)=N$(F)+" "+N$(M)+" "+L$
1530 B%(1,Z)=1E4:B%(2,Z)=S*1E4
1535 M=1E4
1540 FOR T=1 TO  5
1550 C=FNA(5):IF C2$(T+4,C)=""THEN 1550
1560 B%(3,Z)=B%(3,Z)+M*C
1570 C=FNA(5):IF C2$(T+4,C)="" THEN 1570
1580 B%(4,Z)=B%(4,Z)+M*C
1590 M=M/10
1600 NEXT T
1620 NEXT Z
1625 Z=Z-1
1627 Y0=15
2000 PRINT "[144]":GOSUB 20000
2010 POKE 53280,0
2020 PRINT "";"       M E N U  B"
2030 PRINT " 1. POPULATION SUMMARY"
2035 PRINT
2040 PRINT " 2. SEARCH POPULATION    "
2050 PRINT
2060 PRINT " 3. LIST POPULATION          "
2070 PRINT
2080 PRINT " 4. NEXT FIVE YEARS          "
2090 PRINT
2100 PRINT " 5. STOP                     "
2110 PRINT "    ";:INPUT A
2120 IF A>5 OR A<1 THEN 2000
2130 ON A GOTO 2140,2500,3000,3200,4000
2140 REM POPULATION SUMMARY
2150 GOSUB 7000
2160 ON A GOTO 2170,6000,2432,2000
2170 REM CHACTERISTICS
2180 FOR T=1 TO 5
2181 FOR I=1 TO 9
2182 S%(T,I)=0
2183 NEXT I
2184 NEXT T
2190 FOR T=1 TO Z
2200 S=INT(B%(1,T)/10000)
2230 S%(S,1)=S%(S,1)+1
2235 IF S=3 THEN 2330
2240 S=INT(B%(2,T)/10000)
2250 S%(S,2)=S%(S,2)+1
2260 D$=STR$(B%(3,T))
2270 FOR I=1 TO 5
2280 D=VAL(MID$(D$,I+1,1))
2290 S%(D,I+4)=S%(D,I+4)+1
2300 NEXT I
2330 NEXT T
2340 PRINT "[147]"
2345 S3$=""
2350 FOR T=1 TO 9
2355 IF T=3 OR T=4 THEN 2480
2360 PRINT S3$; C1$(T)
2380 FOR I=1 TO 5
2390 IF C2$(T,I)="" THEN 2411
2400 PRINT S3$;"  ";C2$(T,I),S%(I,T)
2410 NEXT I
2411 IF T<>5 THEN 2420
2412 S3$=""
2413 PRINT "";
2420 NEXT T
2425 PRINT "CURRENT YEAR";Y0
2430 GOSUB 20100
2431 GOTO 2140
2432 REM YOB SUMMARY
2433 FOR T=0 TO Y0:Y%(T)=0:NEXT
2434 FOR T=1 TO Z
2435 S=INT(B%(1,T)/10000)
2436 IF S=3 THEN 2439
2437 Y3=B%(2,T)-1E4*INT(B%(2,T)/1E4)
2438 Y%(Y3)=Y%(Y3)+1
2439 NEXT T
2440 PRINT "[147]"
2450 PRINT "YEAR OF BIRTH SUMMARY"
2455 PRINT "THE CURRENT YEAR IS";Y0;""
2456 PRINT "YEAR":PRINT"OF","NUMBER":PRINT"BIRTH","BORN"
2460 FOR T=0 TO 200
2470 IF Y%(T)>0 THEN PRINT T,Y%(T)
2480 NEXT T
2485 PRINT
2490 GOSUB 20100
2495 GOTO 2000
2500 REM SEARCH POPULATION
2501 PRINT "[147]"
2502 PRINT "ENTER LAST NAME TO SEARCH FOR";:INPUT NA$
2510 FOR T=1 TO Z
2512 N$=A$(T):GOSUB 20150
2513 PRINT "[147]S E A R C H I N G"
2514 IF L$<>NA$ THEN 2650
2520 PRINT "[147]";
2521 PRINT A$(T):PRINT ""
2525 S1=          INT(B%(1,T)/10000)
2530 PRINT,C1$(1);":";C2$(1,S1)
2535 S2=          INT(B%(2,T)/10000)
2540 PRINT,C1$(2);":";C2$(2,S2)
2545 PRINT
2550 IF S1<>2 THEN 2570
2560 S3=B%(1,T)-S1*10000:PRINT C1$(4),A$(S3)
2570 S4=B%(2,T)-S2*10000:PRINT "",,C1$(3);S4
2575 PRINT ""
2580 D$=STR$(B%(3,T))
2590 FOR E=1 TO 5
2600 D5=VAL(MID$(D$,E+1,1))
2610 PRINT C1$(E+4);"--",C2$(   E+4,D5)
2620 PRINT
2630 NEXT E
2640 GOSUB 20100
2650 NEXT T
2660 GOTO 2000
3000 REM LIST POPULATION
3010 FOR T=1 TO Z
3020 PRINT "[147]";
3021 PRINT A$(T):PRINT ""
3025 S1=          INT(B%(1,T)/10000)
3030 PRINT,C1$(1);":";C2$(1,S1)
3035 S2=          INT(B%(2,T)/10000)
3040 PRINT,C1$(2);":";C2$(2,S2)
3045 PRINT
3050 IF S1<>2 THEN 3070
3060 S3=B%(1,T)-S1*10000:PRINT C1$(4),A$(S3)
3070 S4=B%(2,T)-S2*10000:PRINT "",,C1$(3);S4
3075 PRINT ""
3080 D$=STR$(B%(3,T))
3090 FOR E=1 TO 5
3100 D5=VAL(MID$(D$,E+1,1))
3110 PRINT C1$(E+4);"--",C2$(   E+4,D5)
3120 PRINT
3130 NEXT E
3140 GOSUB 20100
3150 NEXT T
3160 GOTO 2000
3200 REM NEXT 5 YEARS
3205 M8=0:D8=0:B8=0:Q8=0:Y0=Y0+5
3210 PRINT "[147]";""
3220 POKE 53280,12:POKE 53281,12
3225 PRINT "SEARCHING FOR SINGLES..."
3230 GOSUB 3900
3231 IF M7*F7>0 THEN 3240
3232 IF M7=0 THEN PRINT "THERE ARE NO SINGLE MEN"
3233 IF F7=0 THEN PRINT "THERE ARE NO SINGLE WOMEN"
3234 GOTO 3458
3240 PRINT "DO YOU WANT TO PLAY MATCHMAKER?";:INPUT MM$
3245 PRINT "[147]"
3250 IF LEFT$(MM$,1)="N" THEN 3370
3260 IF LEFT$(MM$,1)<>"Y" THEN 3240
3270 PRINT "SINGLE MEN           SINGLE WOMEN"
3271 FOR T=1 TO M7
3272 N$=A$(SM%(T)):GOSUB 20150
3280 PRINT T;F$;" ";L$
3281 NEXT T
3282 SS=M7:IF F7>M7 THEN SS=F7
3285 PRINT "";"";
3286 R$=""
3287 FOR T=1 TO F7
3288 N$=A$(SF%(T)):GOSUB 20150
3295 PRINT R$;T;F$;" ";L$
3296 NEXT T
3297 PRINT "";:FOR T=1 TO SS:PRINT "";:NEXT
3300 PRINT "ENTER MATCH BY NUMBER (M,F)";:INPUT M2,F2
3310 IF M2>M7 THEN 3300
3320 IF F2>F7 THEN 3300
3330 B%(1,SM%(M2))=B%(1,SM%(M2))+10000+SF%(F2)
3340 B%(1,SF%(F2))=B%(1,SF%(F2))+10000+SM%(M2)
3341 N$=A$(SF%(F2)):GOSUB 20150
3342 A$(SF%(F2))=F$+" "+L$
3343 N$=A$(SM%(M2)):GOSUB 20150
3344 A$(SF%(F2))=A$(SF%(F2))+" "+L$
3346 M8=M8+1:MA%(M8)=SM%(M2)
3350 SF%(F2)=0:SM%(M2)=0
3355 M7=M7-1:F7=F7-1
3360 PRINT "[147]":GOTO 3230
3370 REM COMPUTER MATCHES
3375 PRINT "[147]"
3376 PRINT "COMPUTER MATCHMAKING IN PROGRESS"
3380 GOSUB 3900
3390 SS=M7:IF F7<M7 THEN SS=F7
3395 IF SS=0 THEN 3452
3400 FORMQ=1 TO SS
3405 M2=MQ:F2=MQ
3410 IF F7>M7 THEN F2=F2+F7-M7
3420 IF M7>F7 THEN M2=M2+M7-F7
3430 B%(1,SM%(M2))=B%(1,SM%(M2))+10000+SF%(F2)
3440 B%(1,SF%(F2))=B%(1,SF%(F2))+10000+SM%(M2)
3441 N$=A$(SF%(F2)):GOSUB 20150
3442 A$(SF%(F2))=F$+" "+L$
3443 N$=A$(SM%(M2)):GOSUB 20150
3444 A$(SF%(F2))=A$(SF%(F2))+" "+L$
3446 M8=M8+1:MA%(M8)=SM%(M2)
3450 NEXT MQ
3452 PRINT "THERE WERE";M8;"MARRIAGES"
3454 FOR T=1 TO M8
3455 SP=B%(1,MA%(T))-10000*INT(B%(1,MA%(T))/10000)
3456 PRINT A$(MA%(T));" AND ";A$(SP)
3457 NEXT T
3458 PRINT: GOSUB 20100
3459 GOTO 3605
3460 PRINT "[147]":PRINT "DIVORCES"
3465 D8=0
3466 GOSUB 3900
3468 DI=ABS(M7-F7)
3470 DI=100*DI/Z*2:IF DI<10 THEN DI=10
3472 IF DI>75 THEN DI=75
3480 FOR T=1 TO Z
3490 REM IF B%(2,T)>19999 THEN 3550
3500 IF B%(1,T)<20000 THEN 3550
3505 IF B%(1,T)>29999 THEN 3550
3510 DD=FNA(100):IF DD>DI THEN 3550
3520 SP=B%(1,T)-20000:B%(1,T)=10000
3530 B%(1,SP)=10000
3540 D8=D8+1:DI%(1,D8)=T:DI%(2,D8)=SP
3550 NEXT T
3560 PRINT "";
3562 PRINT "THERE WERE ";D8;" DIVORCES"
3565 IF D8=0 THEN 3600
3570 FOR T=1 TO D8
3580 PRINT A$(DI%(1,T));" AND ";A$(DI%(2,T))
3590 NEXT T
3595 PRINT
3600 GOSUB 20100
3602 RETURN
3605 PRINT "[147]"
3610 PRINT "BIRTHS"
3620 B8=0
3640 FOR T=1 TO Z
3650 IF B%(1,T)<19999 OR B%(1,T)>29999 THEN 3750
3660 IF B%(2,T)<20000 THEN 3750
3665 Y7=Y0-B%(2,T)+10000*INT(B%(2,T)/10000)
3667 SP=B%(1,T)-10000*INT(B%(1,T)/10000)
3670 IF FNA(100)>F%(Y7) THEN 3750
3672 B8=B8+1
3675 S=FNA(2)
3680 N5=NM:IF S=2 THEN N5=NF
3685 F=FNA(N5 )+100*(S-1)
3690 M=FNA( N5)+100*(S-1)
3695 IF M=F THEN 3690
3700 N$=A$(SP):GOSUB 20150
3705 A$(Z+B8)=N$(F)+" "+N$(M)+" "+L$
3710 B%(1,Z+B8)=1E4:B%(2,Z+B8)=S*1E4+Y0
3711 P$(1)=STR$(B%(3,T)):P$(2)=STR$(B%(4,T))
3712 P$(3)=STR$(B%(3,SP)):P$(4)=STR$(B%(4,SP))
3715 M=1E4
3720 FOR U=1 TO  5
3725 C =FNA(4)
3727 P5=VAL(MID$(P$(C),U+1,1))
3730 B%(3,Z+B8)=B%(3,Z+B8)+M*P5
3735 D=FNA(4):IF D=C THEN 3735
3737 P5=VAL(MID$(P$(D),U+1,1))
3740 B%(4,Z+B8)=B%(4,Z+B8)+M*P5
3745 M=M/10
3746 NEXT U
3748 BI%(1,B8)=T:BI%(2,B8)=SP:BI%(3,B8)=Z+B8
3750 NEXT T
3760 PRINT "THERE WERE";B8;"BIRTHS"
3765 IF B8=0 THEN 3800
3770 FOR T=1 TO B8
3780 PRINT A$(BI%(3,T));" WAS BORN TO ";A$(BI%(1,T));" AND ";A$(BI%(2,T))
3785 PRINT :PRINT
3786 FOR K=1 TO 500*T:NEXT
3790 NEXT T
3795 Z=Z+B8
3800 GOSUB 20100
3802 GOSUB 3460
3805 PRINT "[147]"
3810 PRINT "DEATHS"
3811 TP=FNA(23):IF B8+Z>500 THEN TP=1
3812 IF TP<3 THEN PRINT "TYPHOON STRIKES ISLAND!!!"
3815 FOR T=1 TO Z
3817 S=INT(B%(1,T)/10000):IF S=3 THEN 3885
3820 Y7=Y0-B%(2,T)+10000*INT(B%(2,T)/10000)
3821 QQ=Q%(Y7):IF TP<3 THEN QQ=QQ/2
3825 IF FNA(1000)<QQ     THEN 3885
3830 SP=B%(1,T)-10000*INT(B%(1,T)/10000)
3835 B%(1,T)=30000:PRINT A$(T);" AGE";Y7
3840 IF SP=0 THEN 3880
3845 B%(1,SP)=10000:PRINT "  SURVIVED BY ";A$(SP):PRINT
3880 PRINT
3885 NEXT T
3890 GOSUB 20100
3891 IF FNA(50)>2+Y0/15 THEN 3895
3892 GOSUB 8000
3895 GOTO 2000
3900 REM SEARCH FOR SINGLES
3905 M7=0:F7=0
3910 FOR T=1 TO Z
3920 IF B%(1,T)>10000 THEN 3960
3925 Y7=Y0-B%(2,T)+10000*INT(B%(2,T)/10000)
3927 IF Y7<19 THEN 3960
3930 IF B%(2,T)<20000 THEN 3950
3940 F7=F7+1:SF%(F7)=T:GOTO 3960
3950 M7=M7+1:SM%(M7)=T
3960 NEXT T
3970 RETURN
4000 END
6000 FOR T=1 TO 9:L%(T)=0:NEXT
6001 FOR T=1 TO Z
6002 S=INT(B%(1,T)/10000)
6003 IF S=3 THEN 6009
6004 N$=A$(T):GOSUB 20150
6005 FOR I=1 TO 9
6006 IF L$=L$(I) THEN 6008
6007 NEXT I
6008 L%(I)=L%(I)+1
6009 NEXT T
6010 PRINT "[147]"
6020 PRINT "LAST NAME SUMMARY"
6030 FOR T=1 TO 9
6035 IF L%(T)=0 THEN 6050
6040 PRINT L$(T),L%(T)
6050 NEXT T
6060 GOSUB 20100
6070 GOTO 2140
7000 PRINT "[149]":GOSUB 20000
7005 POKE 53281,1
7010 POKE 53280,9
7020 PRINT "";"       M E N U  C  -  SUMMARIES"
7030 PRINT " 1. CHARACTERISTICS   "
7035 PRINT
7040 PRINT " 2. LAST NAME            "
7050 PRINT
7060 PRINT " 3. YEAR OF BIRTH       "
7070 PRINT
7080 PRINT " 4. RETURN TO MENU B      "
7090 PRINT "    ";:INPUT A
7100 IF A>4 OR A<1 THEN 7000
7110 RETURN
8000 REM VISITOR
8002 IF L$(9)="" THEN 8010
8004 RETURN
8010 L$(9)="CASANOVA"
8020 Z=Z+1:ZC=Z
8030 A$(Z)="ALDO VICTOR CASANOVA"
8040 PRINT "[147]"
8050 POKE 53281,7:POKE 53280,7:PRINT ""
8060 PRINT "A YOUNG MAN IS WASHED ASHORE"
8070 PRINT "     HIS NAME IS ";A$(Z)
8080 GOSUB 20100
8085 B%(1,Z)=1E4:B%(2,Z)=1E4:M=1E4
8090 FOR T=1 TO 5
8100 C=FNA(5):IFC2$(T+4,C)=""THEN 8100
8110 B%(3,Z)=B%(3,Z)+M*C
8120 B%(4,Z)=B%(4,Z)+M*C
8130 M=M/10
8140 NEXT T
8145 PRINT "[147]"
8150 PRINT "THERE WERE SOME DIVORCES..."
8160 D8=0:DI=80-Y0/4
8170 GOSUB 3480
8180 PRINT "[147]"
8190 PRINT "   AND SOME BIRTHS..."
8191 B8=0
8195 FOR T=1 TO Z
8200 IF B%(2,T)<20000 THEN 8750
8210 IF B%(1,T)>19999 THEN 8750
8215 REM PRINT B%(1,T),B%(2,T),A$(T)
8220 Y7=Y0-B%(2,T)+10000*INT(B%(2,T)/10000)
8230 SP=ZC
8670 IF FNA(100)>F%(Y7) THEN 8750
8672 B8=B8+1
8675 S=FNA(2)
8680 N5=NM:IF S=2 THEN N5=NF
8685 F=FNA(N5 )+100*(S-1)
8690 M=FNA( N5)+100*(S-1)
8695 IF M=F THEN 8690
8700 N$=A$(SP):GOSUB 20150
8705 A$(Z+B8)=N$(F)+" "+N$(M)+" "+L$
8710 B%(1,Z+B8)=1E4:B%(2,Z+B8)=S*1E4+Y0
8711 P$(1)=STR$(B%(3,T)):P$(2)=STR$(B%(4,T))
8712 P$(3)=STR$(B%(3,SP)):P$(4)=STR$(B%(4,SP))
8715 M=1E4
8720 FOR U=1 TO  5
8725 C =FNA(4)
8727 P5=VAL(MID$(P$(C),U+1,1))
8730 B%(3,Z+B8)=B%(3,Z+B8)+M*P5
8735 D=FNA(4):IF D=C THEN 3735
8737 P5=VAL(MID$(P$(D),U+1,1))
8740 B%(4,Z+B8)=B%(4,Z+B8)+M*P5
8745 M=M/10
8746 NEXT U
8748 BI%(1,B8)=T:BI%(2,B8)=SP:BI%(3,B8)=Z+B8
8750 NEXT T
8760 PRINT "THERE WERE";B8;"BIRTHS"
8765 IF B8=0 THEN 8800
8770 FOR T=1 TO B8
8780 PRINT A$(BI%(3,T));" WAS BORN TO ";A$(BI%(1,T));" AND ";A$(BI%(2,T))
8785 PRINT :PRINT
8786 FOR K=1 TO 500*T:NEXT
8790 NEXT T
8795 Z=Z+B8
8800 GOSUB 20100
8810 PRINT "[147]"
8820 PRINT "   AND A DEATH!"
8830 B%(1,ZC)=30000
8840 PRINT "",A$(ZC);" AGE ??"
8850 GOSUB 20100
8860 RETURN
20000 REM BORDER
20010 PRINT "[147]";
20015 PRINT "";
20020 S$=" [146]":T$=S$+"[157]":U$="[157][157]"+S$
20030 FOR T=1 TO 37:PRINTS$;:NEXT
20040 FOR T=1 TO 23:PRINT T$;:NEXT
20045 PRINT "[145]";
20050 FOR T=1 TO 37:PRINT U$;:NEXT
20060 V$="[145][157]"+S$
20070 FOR T=1 TO 22:PRINTV$;:NEXT
20080 RETURN
20100 REM SPASBAR
20110 PRINT "[144]";"";"";
20120 PRINT "HIT SPACE BAR TO CONTINUE[146]";
20130 GETS9$:T8=RND(1):IFS9$<>" "THEN20130
20140 RETURN
20150 REM FIRST MIDDLE LAST
20160 SQ=0:F$="":M$="":L$=""
20170 FOR YY=1 TO LEN(N$)
20180 KK$=MID$(N$,YY,1)
20190 IF KK$=" " THEN SQ=SQ+1:GOTO 20230
20200 IF SQ=0 THEN F$=F$+KK$
20210 IF SQ=1 THEN M$=M$+KK$
20220 IF SQ=2 THEN L$=L$+KK$
20230 NEXT YY
20240 RETURN
21000 GOTO 21000